home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / TUTORIAL / 1307B.ZIP / REAL2FIL.MOD < prev    next >
Text File  |  1989-01-18  |  5KB  |  192 lines
  1. IMPLEMENTATION MODULE Real2Fil;
  2.  
  3. (*        Copyright (c) 1987, 1989 - Coronado Enterprises         *)
  4.  
  5. FROM ASCII       IMPORT EOL;
  6. FROM FileSystem  IMPORT File, WriteChar;
  7. FROM Conversions IMPORT ConvertCardinal, ConvertInteger,
  8.                         ConvertOctal, ConvertHex;
  9.  
  10. VAR OutString : ARRAY[0..80] OF CHAR;
  11.  
  12.  
  13.  
  14. PROCEDURE WriteLnFile(VAR FileName : File);
  15. BEGIN
  16.    WriteChar(FileName,EOL);
  17. END WriteLnFile;
  18.  
  19.  
  20.  
  21. PROCEDURE WriteStringFile(VAR FileName : File;
  22.                           String   : ARRAY OF CHAR);
  23. VAR Index : CARDINAL;
  24. BEGIN
  25.    Index := 0;
  26.    WHILE String[Index] <> 000C DO
  27.       WriteChar(FileName,String[Index]);
  28.       Index := Index + 1;
  29.    END;
  30. END WriteStringFile;
  31.  
  32.  
  33.  
  34. PROCEDURE WriteCardFile(VAR FileName : File;
  35.                         DataOut  : CARDINAL;
  36.                         FieldSize : CARDINAL);
  37. VAR Index : CARDINAL;
  38. BEGIN
  39.    ConvertCardinal(DataOut,6,OutString);
  40.    WHILE FieldSize > 6 DO
  41.       WriteChar(FileName," ");
  42.       FieldSize := FieldSize - 1;
  43.    END;
  44.    FOR Index := 0 TO 5 DO
  45.       IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
  46.          WriteChar(FileName,OutString[Index]);
  47.       END;
  48.    END;
  49. END WriteCardFile;
  50.  
  51.  
  52.  
  53. PROCEDURE WriteIntFile(VAR FileName : File;
  54.                        DataOut  : INTEGER;
  55.                        FieldSize : CARDINAL);
  56. VAR Index : CARDINAL;
  57. BEGIN
  58.    ConvertInteger(DataOut,6,OutString);
  59.    WHILE FieldSize > 6 DO
  60.       WriteChar(FileName," ");
  61.       FieldSize := FieldSize - 1;
  62.    END;
  63.    FOR Index := 0 TO 5 DO
  64.       IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
  65.          WriteChar(FileName,OutString[Index]);
  66.       END;
  67.    END;
  68. END WriteIntFile;
  69.  
  70.  
  71.  
  72. PROCEDURE WriteOctFile(VAR FileName : File;
  73.                        DataOut  : CARDINAL;
  74.                        FieldSize : CARDINAL);
  75. VAR Index : CARDINAL;
  76. BEGIN
  77.    ConvertOctal(DataOut,6,OutString);
  78.    WHILE FieldSize > 6 DO
  79.       WriteChar(FileName," ");
  80.       FieldSize := FieldSize - 1;
  81.    END;
  82.    FOR Index := (6 - FieldSize) TO 5 DO
  83.       WriteChar(FileName,OutString[Index]);
  84.    END;
  85. END WriteOctFile;
  86.  
  87.  
  88.  
  89. PROCEDURE WriteHexFile(VAR FileName : File;
  90.                        DataOut  : CARDINAL;
  91.                        FieldSize : CARDINAL);
  92. VAR Index : CARDINAL;
  93. BEGIN
  94.    ConvertHex(DataOut,4,OutString);
  95.    WHILE FieldSize > 4 DO
  96.       WriteChar(FileName," ");
  97.       FieldSize := FieldSize - 1;
  98.    END;
  99.    FOR Index := (4 - FieldSize) TO 3 DO
  100.       WriteChar(FileName,OutString[Index]);
  101.    END;
  102. END WriteHexFile;
  103.  
  104.  
  105. (* This procedure uses a rather lengthy method for decomposing the *)
  106. (* REAL number and forming it into single characters.  There may   *)
  107. (* be a procedure in your compilers library to do this for you     *)
  108. (* but this method is kept as an example of how to decompose the   *)
  109. (* number to prepare it for output.  It could be much more effi-   *)
  110. (* cient to use your compilers library call.                       *)
  111.  
  112. PROCEDURE WriteRealFile(VAR FileName : File;
  113.                         DataOut  : REAL;
  114.                         FieldSize : CARDINAL;
  115.                         Digits    : CARDINAL);
  116.  
  117. VAR Index          : CARDINAL;
  118.     Field          : CARDINAL;
  119.     Count          : CARDINAL;
  120.     WholeFieldSize : CARDINAL;
  121.     ABSDataOut     : REAL;
  122.     Char           : CHAR;
  123.     RoundReal      : REAL;
  124.  
  125. BEGIN
  126.    IF DataOut >= 0.0 THEN   (* Get the absolute value to work with *)
  127.       ABSDataOut := DataOut;
  128.    ELSE
  129.       ABSDataOut := -DataOut;
  130.    END;
  131.  
  132.                          (* Make sure the Digits field is positive *)
  133.    IF Digits < 0 THEN
  134.       Digits := 0;
  135.    END;
  136.  
  137.         (* Make sure there are 3 or more digits for the whole part *)
  138.    IF (FieldSize - Digits) < 3 THEN
  139.       FieldSize := Digits + 3;
  140.    END;
  141.  
  142.    RoundReal := 0.5;         (* This is used for rounding the data *)
  143.    IF Digits = 0 THEN
  144.       WholeFieldSize := FieldSize;
  145.    ELSE
  146.       WholeFieldSize := FieldSize - Digits - 1;
  147.       FOR Count := 1 TO Digits DO
  148.          RoundReal := RoundReal * 0.1;    (* Reduce for each digit *)
  149.       END;
  150.    END;
  151.    ABSDataOut := ABSDataOut + RoundReal;    (* Add rounding amount *)
  152.  
  153.    Count := 0;
  154.    WHILE ABSDataOut >= 1.0 DO
  155.       Count := Count + 1;              (* Count significant digits *)
  156.       ABSDataOut := 0.1 * ABSDataOut;
  157.    END;
  158.  
  159.    WHILE WholeFieldSize > (Count + 1) DO  (* Output leading blanks *)
  160.       WriteChar(FileName," ");
  161.       WholeFieldSize := WholeFieldSize - 1;
  162.    END;
  163.  
  164.    IF DataOut >= 0.0 THEN          (* Output the sign (- or blank) *)
  165.       WriteChar(FileName," ");
  166.    ELSE
  167.       WriteChar(FileName,"-");
  168.    END;
  169.  
  170.    WHILE Count > 0 DO       (* Output the whole part of the number *)
  171.       ABSDataOut := 10.0 * ABSDataOut;
  172.       Index := TRUNC(ABSDataOut);
  173.       Char := CHR(Index + 48);                   (* 48 = ASCII '0' *)
  174.       WriteChar(FileName,Char);
  175.       ABSDataOut := ABSDataOut - FLOAT(Index);
  176.       Count := Count - 1;
  177.    END;
  178.  
  179.    IF Digits > 0 THEN  (* Output the fractional part of the number *)
  180.       WriteChar(FileName,'.');
  181.       FOR Count := 1 TO Digits DO
  182.          ABSDataOut := 10.0 * ABSDataOut;
  183.          Index := TRUNC(ABSDataOut);
  184.          Char := CHR(Index + 48);                (* 48 = ASCII '0' *)
  185.          WriteChar(FileName,Char);
  186.          ABSDataOut := ABSDataOut - FLOAT(Index);
  187.       END;
  188.    END;
  189. END WriteRealFile;
  190.  
  191. END Real2Fil.
  192.